perm filename DDD[LSP,BGB] blob
sn#017663 filedate 1972-12-27 generic text, type T, neo UTF8
00100 SUBTTL GARBAGE COLLECTER --- PAGE 16
00200
00300 GC: PUSHJ P,AGC
00400 JRST FALSE
00500
00600 AGC: DAC R,RGC#
00700 GCPK1: PUSH P,PA3
00800 PUSH P,PA4
00900 PUSH P,UBDPTR ;special atom UNBOUND; not on OBLIST
01000 PUSH P,MKNAM3
01100 PUSH P,GCMKL ;i/o channel INPUT lists and arrays
01200 PUSH P,BIND3
01300 PUSH P,INITF
01400 GCPK2: PUSH P,[XWD 0,GCP6] ;this is a return address
01500
01600 ;save AC 0 thru 10 in (regPDL)+1 thru +11.
01700 lac s,orgPDL
01800 addi s,11
01900 dap s,.+2
02000 subi s,10
02100 blt s,x
02200 ;clear bit tables.
02300 lac a,orgHBT
02400 setzm (a)
02500 hrl a,a
02600 aos a
02700 lac endFBT
02800 dap .+1
02900 blt a,x
03000 setz ;indicate GC on CPU lights.
03100 ;report what is exhausted.
03200 SKIPN GCGAGV
03300 JRST GCP5A
03400 SKIPN F
03500 STRTIP [SIXBIT /←FREE STG EXHAUSTED←!/]
03600 SKIPN FF
03700 STRTIP [SIXBIT /←FULL WORD SPACE EXHAUSTED←!/]
03800 ;mark time of GC entry.
03900 GCP5A: MOVEI TT,1 ;bit for marking.
04000 MOVEI A,0
04100 CALLI A,STIME ;time
04200 MOVNS A
04300 ADDM A,GCTIM#
04400 ;Initialize HBT referances.
04500 lacn A,orgHWS
04600 ash A,-5
04700 add A,orgHBT
04800 aos A
04900 dap A,GCBTP1
05000 dap A,GCBTP2
05100 lac A,orgFBT
05200 dap A,C2GC
00100 ;get a node off the PDL.
00200 GCP3: LAC C,orgPDL ;start at the bottom of the PDL.
00300 GCP6B: LAC S,P
00400 HLL C,P
00500 MOVEI B,0
00600 GC1: CAMN C,S
00700 POPJ P,
00800 CDR A,(C)
00900
01000 ;Address Test for within LISP space.
01100 GCP: CAMG A,endFWS
01200 CAMGE A,orgHWS
01300 JRST GCEND
01400 CAMLE A,endHWS
01500 JRST GCMFWS
01600
01700 ;mark a LISP node of the halfword space.
01800 LAC F,(A)
01900 LSHC A,-5
02000 ROT B,5
02100 LAC AR1,GCBT(B)
02200 GCBTP2: TDOE AR1,X(A)
02300 JRST GCEND
02400 GCBTP1: DAC AR1,X(A)
02500 PUSH P,F
02600 CAR A,F
02700 JRST GCP
02800
02900 ;mark a full word.
03000 GCMFWS: LAC AR1,A
03100 SUB AR1,orgFWS
03200 IDIVI AR1,44
03300 MOVNS AR2A
03400 LSH AR2A,36
03500 ADD AR2A,C2GC
03600 DPB TT,AR2A
03700 GCEND: CAMN P,S
03800 AOJA C,GC1
03900 POP P,A
04000 HRRZS A
04100 JRST GCP
04200
04300 GCMKL: XWD 0,.+1
04400 XWD .+1,0
04500 XWD -NIOCH,CHTAB+FSTCH
04600 C2GC: XWD 430100+AR1,X ;.=bottom of fws bit table
04700 GCBT: FOR I←0,=31{(1B0)⊗(-I)↔}
00100 GCP6: CDR R,SC2
00200 GCP6C: CAIL R,(SP) ;mark sp
00300 JRST GCP6A
00400 PUSH P,(R)
00500 CDR C,P
00600 PUSHJ P,GCP6B
00700 SUB P,[XWD 1,1]
00800 AOJA R,GCP6C
00900
01000 GCP6A: CDR R,GCMKL ;mark arrays
01100 GCP6D: JUMPE R,GCSWP
01200 CAR A,(R)
01300 LAC D,(A)
01400 GCP6E: PUSH P,(D)
01500 CDR C,P
01600 PUSH P,(D)
01700 MOVSS (P)
01800 PUSHJ P,GCP6B
01900 SUB P,[XWD 2,2]
02000 AOBJN D,GCP6E
02100 CDR R,(R)
02200 JRST GCP6D
02300
00100 ;Half Word Space Garbage Collection Sweep.
00200
00300 GFSWPP:
00400 JUMPL S,3 ;0
00500 DAPZ F,(R) ;1 put R on Free List.
00600 CDR F,R ;2
00700 LSH S,1 ;3 next bit.
00800 AOBJN R,0 ;4 address next word.
00900 LAC S,(D) ;5 get more bits from HBT.
01000 HRLI R,-40 ;6 set bit counter.
01100 AOBJN D,0 ;7 increm HBT pointer.
01200 JRST X ;10 return from AC's.
01300 ;11 S word from HBT.
01400 ;12 D -wrdcnt,,HBT ptr.
01500 ;13 R -bitcnt,,HWS ptr.
01600 ;14 P
01700 ;15 F free storage list.
01800
01900
02000 GCSWP: MOVSI R,GFSWPP
02100 BLT R,10
02200 MOVEI F,NIL ;will become movei f,-1
02300 lacn D,sizHBT
02400 aos D ;ignore last fractional word.
02500 hrlz D,D
02600 lap D,orgHBT
02700 lac R,orgHWS
02800 andi R,37
02900 dap R,GCBTL2
03000 subi R,=32
03100 hrlz R,R
03200 lap R,orgHWS
03300 LAC S,(D)
03400 GCBTL2: ROT S,X ;first fractional word.
03500 hrri 10,.+2
03600 AOBJN D,0
00100 ;Full Word Space Garbage Collection Sweep.
00200
00300 lacn A,sizFWS
00400 movss A
00500 lap A,orgFWS
00600 lac B,endHBT
00700 hrli B,100
00800
00900 MOVEI FF,0
01000 GCS1: ILDB C,B
01100 JUMPN C,GCS2
01200 DAPZ FF,(A)
01300 CDR FF,A
01400 GCS2: AOBJN A,GCS1
00100 SKIPN GCGAGV
00200 JRST GCSP1
00300 LAC B,F
00400 PUSHJ P,GCPNT
00500 STRTIP [SIXBIT / FREE STG,!/]
00600 LAC B,FF
00700 PUSHJ P,GCPNT
00800 STRTIP [SIXBIT / FULL WORDS AVAILABLE←!/]
00900 GCSP1: CDR S,orgPDL
01000 AOS S
01100 MOVSS s
01200 BLT S,NACS+3 ;reload ac's
01300 SUB P,[XWD GCPK2-GCPK1,GCPK2-GCPK1] ;restore p
01400 JUMPE F,[ERR2 [SIXBIT /NO FREE STG LEFT!/]]
01500 JUMPE FF,[ERR2 [SIXBIT /NO FW STG LEFT!/]]
01600 LAC R,RGC
01700 MOVEI A,0
01800 CALLI A,STIME ;time
01900 ADDM A,GCTIM
02000 POPJ P,
02100
00100 ;Garbage Collector Statistics.
00200
00300 GCGAG: EXCH A,GCGAGV#
00400 POPJ P,
00500
00600 GCTIME: LAC A,GCTIM
00700 JRST FIX1A
00800
00900 TIME: MOVEI A,0
01000 CALLI A,STIME
01100 JRST FIX1A
01200
01300 SPEAK: LAC A,CONSVAL#
01400 JRST FIX1A
01500
01600 GCPNT: MOVEI R,TTYO
01700 MOVEI A,0
01800 JUMPE B,PRINL1
01900 CDR B,(B)
02000 AOJA A,.-2
00100 SUBTTL GETSYM --- PAGE 17
00200
00300 R50MAK: PUSHJ P,PNAMUK
00400 PUSH C,[0]
00500 HRLI C,700
00600 HRRI C,(SP)
00700 MOVEI B,0
00800 MK3: ILDB A,C
00900 LDB A,R50FLD
01000 CAMGE B,[50*50*50*50*50]
01100 SKIPN A
01200 POPJ P,
01300 IMULI B,50
01400 ADD B,A
01500 JRST MK3
01600
00100 ;Examine Symbol Table. ((code . name). value) ← XSYM(addr).
00200 XSYM:
00300 BEGIN XSYM
00400 pushj p,NUMVAL↔push P,A ;save address.
00500 aos A↔pushj P,XHALF+1
00600 exch A,(P) ;save symbol's value.
00700 lac A,(A) ;fetch symbol Radix 50.
00800
00900 setz B,↔rotc A,4↔lsh A,-4 ;RADIX 50 in A.
01000 addi B,INUM0↔push p,B ;type code to stack.
01100 setz B,↔push p,B ;NIL to stack
01200 push p,A ;A to stack.
01300 L1: idivi A,50↔dac A,(P)
01400 jumpe B,L2
01500
01600 ;Convert RADIX 50 character into ASCII.
01700
01800 movei A,INUM0-2(B) ;sharp,dollar,percent.
01900 caig B,12↔movei A,INUM0+57(B) ;numerals.
02000 caig B,44↔movei A,INUM0+66(B) ;letters.
02100 pushj P,AASCII ;convert to Atom.
02200 ;Place character atom into list.
02300 lac B,-1(P)
02400 pushj P,CONS
02500 dac A,-1(P)
02600
02700 L2: skipe A,(P) ;test for done.
02800 jrst L1
02900
03000 pop p,A
03100 pop p,A ;the list.
03200 skipe A ;no symbol name.
03300 pushj p,MAKNAM
03400 pop p,B
03500 pushj P,XCONS ;return dotted pair - (type . symbol).
03600 pop p,B
03700 jrst CONS ;returns ((type.symbol).value).
03800 BEND
03900
04000 ;Examine numeric Half words.
04100 XHALF: pushj p,numval
04200 push p,A
04300 cdr A,(A)↔pushj p,fix1A↔exch A,(P)
04400 hlre A,(A)↔pushj p,fix1A↔pop p,B
04500 jrst CONS
01700 GETSYM: PUSHJ P,R50MAK
01800 TLO B,040000 ;04 for globals
01900 LAC C,JOBSYM
02000 MK7: CAMN B,(C)
02100 JRST MK10 ;found
02200 AOBJP C,.+2
02300 AOBJN C,MK7
02400 TLC B,140000 ;10 for locals
02500 TLNE B,100000
02600 JRST MK7-1
02700 JRST FALSE
02800
02900 MK10: LAC A,1(C) ;value
03000 JRST FIX1A
03100
03200 PUTSYM: PUSH P,B
03300 PUSHJ P,R50MAK
03400 LAC A,B
03500 TLO A,040000 ;make global
03600 SKIPL JOBSYM
03700 AOS JOBSYM ;increment initial symbol table pointer
03800 MOVN B,[XWD 2,2]
03900 ADDB B,JOBSYM
04000 DAC A,(B) ;name
04100 POP P,1(B) ;value
04200 JRST FALSE
04300
04400 PATCH: BLOCK 200
00100 SUBTTL ALVINE AND LOADER INTERFACES --- PAGE 18
00200
00300 ;interface to alvine
00400
00500 ED: MOVEI 10,EDXX
00600 JRST (10)
00700
00800 GRINDEF: PUSH P,A
00900 PUSHJ P,ED
01000 POP P,A
01100 JRST 2(10)
01200
01300 EXCISE: JRST TRUE
01400
01500 XLIST
01600 VAR
01700 LIT
01800 LIST
00100 SYSINI: DAC A,NAME+1
00200 SETZM NAME+3
00300 INIT 17
00400 SIXBIT /SYS/
00500 0
00600 JRST AIN.4+1
00700 LOOKUP NAME
00800 JRST AIN.7+1
00900 INPUT [IOWD 1,NAME+3 ;INPUT size of file
01000 0]
01100 HLRO A,NAME+3
01200 POPJ P,
01300
01400 NAME: SIXBIT /LISP/
01500 0
01600 0
01700 0
01800
01900 SYSINP: DAC A,LST
02000 INPUT LST
02100 STATZ 740000
02200 ERR1 AIN.8
02300 RELEASE
02400 POPJ P,
02500
02600 LST: 0
02700 0
00100 ;Size argument taken from A, pointer returned in A.
00200 MORCOR: DAC 0,LISPAC
00300 LAC 0,[XWD 1,LISPAC+1]
00400 BLT 0,LISPAC+17
00500 LAC 3,A
00600 LAC 12,AC12
00700 LAC 16,AC16
00800 LAC 17,AC17
00900 PUSHJ 17,CORGET
01000 OUTSTR[ASCIZ/NO MORE CORE./]
01100 LAC A,2
01200 LAC 0,[XWD LISPAC+2,2]
01300 BLT 0,17
01400 LAC 0,LISPAC
01500 POPJ P,
01600
01700 VAR
01800 LIT
00100 COMMENT/
00200 INTERN MEMQ,UNBOUN
00300 INTERN EVBIG,NUMBP2,OPOV,NUMV2,NUMV3,NUMV4,OPR,FLOOV,FIX2
00400 INTERN NUM1,NUM3,BPR,FWCONS,FALSE,TRUE,FW0CNS,NCONS
00500 INTERN READ,READP1,MAKNUM,PRIN1,PRINT,EXPLODE,SASSOC,EQUAL,SUBST
00600 INTERN CHCT,LINL,OLDCH,FLATSIZE,TYI,RATOM,CHRCT,TYOD
00700 INTERN GET,INTERN,REMOB,MAKNAM,GENSYM,FIX,LENGTH,READLIST,PATOM
00800 INTERN LAST,INC,OUTC,FIX1A,NUMVAL,REVERSE,MAPLIST,GC,GETL,PUTPROP
00900 INTERN ERR,MAPCAR,REMPROP,LIST,SETQ,ERRSET,REMOB,ARRAY,APPEND
01000 INTERN SPECBIND,SPECSTR,XCONS,ATOM,READCH,SET,NCONC,PRINC
01100 INTERN CONS,ACONS,CTY,FP7A1,TERPRI,LSPRET,PSAV1,BKTRC
01200 INTERN TYO,ITYO,IGSTRT,NOINFG,CHRTAB
01300 INTERN EVAL,OEVAL,.APPEND,INPUT,OUTPUT/